home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
pgvw174.zip
/
RSB1CHAT.MRG
< prev
next >
Wrap
Text File
|
1992-06-24
|
22KB
|
490 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against \temp\rbbssub1.bas to produce new\rsb1chat.bas
* \temp\rbbssub1.bas: Date 6-20-1992 Size 55569 bytes
* ------------[ Created 06-24-1992 22:51:54 ]------------
* REPLACING old line(s) by new
117 IF ZSubParm <> -62 THEN _
IF PrevRead$ = ConfigFile$ THEN _
EXIT SUB _
ELSE PrevRead$ = ConfigFile$
CLOSE 2
ZBulletinSave$ = ZBulletinMenu$
CALL OpenWork (2,ConfigFile$)
ZCurDef$ = ConfigFile$
INPUT #2,ZWasDF$, _
ZDnldDrives$, _
ZSysopPswd1$, _
ZSysopPswd2$, _
ZSysopFirstName$, _
ZSysopLastName$, _
ZRequiredRings, _
ZStartOfficeHours, _
ZEndOfficeHours, _
ZMinsPerSession, _
ZWasDF, _
ZWasDF, _
ZUpldDir$, _
ZExpertUserDef, _
ZActiveBulletins, _
ZPromptBellDef, _
ZWasDF, _
ZMenusCanPause, _
ZMenu$(1), _
ZMenu$(2), _
ZMenu$(3), _
ZMenu$(4), _
ZMenu$(5), _
ZMenu$(6), _
ZConfMenu$, _
ZTestANSITime, _
ZWelcomeInterruptable, _
ZRemindFileXfers, _
ZPageLengthDef, _
ZMaxMsgLinesDef, _
ZDoorsAvail, _
ZWasDF$, _
ZMainMsgFile$, _
ZMainMsgBackup$
INPUT #2, WasX$, _
ZCmntsFile$, _
ZMainUserFile$, _
ZWelcomeFile$, _
ZNewUserFile$, _
ZMainDirExtension$
CALL BreakFileName (WasX$,ZWasY$,ZWasDF$,ZWasZ$,ZFalse)
IF ZWasDF$ <> "" THEN _
ZCallersFile$ = WasX$
INPUT #2, ZWasDF$
IF ZComPort$ <> "COM0" THEN _
IF NOT ZConfMode THEN _
ZComPort$ = ZWasDF$
INPUT #2, ZBulletinsOptional, _
ZModemInitCmd$, _
ZRTS$, _
ZCallersLst$, _
ZFG, _
ZBG, _
ZBorder
IF ZConfMode THEN _
INPUT #2, ZWasDF$, _
ZWasDF$ _
ELSE INPUT #2, ZRBBSBat$ , _
ZRCTTYBat$
INPUT #2,ZOmitMainDir$, _
ZFirstNamePrompt$, _
ZHelp$(3), _
ZHelp$(4), _
ZHelp$(7), _
ZHelp$(9), _
ZBulletinMenu$, _
ZBulletinPrefix$, _
ZWasDF$, _
ZMsgReminder, _
ZRequireNonASCII, _
ZAskExtendedDesc, _
ZMaxNodes, _
ZNetworkType
IF ZConfMode THEN _
INPUT #2, ZwasDF _
ELSE INPUT #2, ZRecycleToDos
INPUT #2,ZWasDF, _
ZWasDF, _
ZTrashcanFile$
INPUT #2,ZMinLogonSec, _
ZDefaultSecLevel, _
ZSysopSecLevel, _
ZFileSecFile$, _
ZSysopMenuSecLevel, _
ZConfMailList$, _
ZMaxViolations, _
ZOptSec(50), _ ' SECURITY FOR SYSOP COMMANDS 1
ZOptSec(51), _
ZOptSec(52), _
ZOptSec(53), _
ZOptSec(54), _
ZOptSec(55), _
* ------[ first line different ]------
ZOptSec(56) ' SYSOP 7 ' DR062202
OldPswdFile$=ZPswdFile$ ' DR062202
INPUT #2,ZPswdFile$ ' DR062202
IF ZPswdFile$ = "NONE" THEN ZPswdFile$ = OldPswdFile$ ' DR062202
INPUT #2,ZMaxPswdChanges, _ ' DR062202
ZMinSecForTempPswd, _
ZOverWriteSecLevel, _
ZDoorsTermType, _
ZMaxPerDay
INPUT #2,ZOptSec(1), _ ' SECURITY FOR MAIN MENU COMMANDS 1
ZOptSec(2), _
ZOptSec(3), _
ZOptSec(4), _
ZOptSec(5), _
ZOptSec(6), _
ZOptSec(7), _
ZOptSec(8), _
ZOptSec(9), _
ZOptSec(10), _
ZOptSec(11), _
ZOptSec(12), _
ZOptSec(13), _
ZOptSec(14), _
ZOptSec(15), _
ZOptSec(16), _
ZOptSec(17), _
ZOptSec(18), _ ' MAIN COMMAND 18
ZMinNewCallerBaud, _
ZWaitBeforeDisconnect
INPUT #2,ZOptSec(19), _ ' Security for FILE COMMANDS 1
ZOptSec(20), _
ZOptSec(21), _
ZOptSec(22), _
ZOptSec(23), _
ZOptSec(24), _
ZOptSec(25), _
ZOptSec(26), _ ' FILE COMMAND 8
ZOptSec(27), _ ' SECURITY FOR UTILITY COMMANDS 1
ZOptSec(28), _
ZOptSec(29), _
ZOptSec(30), _
ZOptSec(31), _
ZOptSec(32), _
ZOptSec(33), _
ZOptSec(34), _
ZOptSec(35), _
ZOptSec(36), _
ZOptSec(37), _
ZOptSec(38), _ ' UTIL COMMAND 12
ZOptSec(46), _ ' SECURITY FOR GLOBAL COMMANDS 1
ZOptSec(47), _
ZOptSec(48), _
ZOptSec(49), _
ZUpldTimeFactor!, _
ZComputerType, _
ZRemindProfile, _
ZRBBSName$, _
ZCmdsBetweenRings, _
ZCopyrightSecs, _
ZPagingPtrSupport$
IF ZConfMode THEN _
INPUT #2, ZwasDF _
ELSE INPUT #2, ZModemInitBaud$
IF ZErrCode > 0 THEN _
EXIT SUB
* INSERTING new line(s)
1204 ' $SUBTITLE: 'VIEWCHEK -- subroutine to check for paging ' DR062201
' $PAGE ' DR062201
' ' DR062201
' NAME -- VIEWCHEK ' DR062201
' ' DR062201
' PURPOSE -- CHECKS TO SEE IF THE USER IS BEING PAGED ' DR062201
' ' DR062201
SUB VIEWCHEK STATIC ' DR062201
ON ERROR GOTO 65000 ' DR062201
FILE.NME$ = "RBBS" + ZNodeID$ + "PG" ' DR062201
SubSave = ZSubParm : ZSubParm = 1 ' DR062201
OPEN "I",7,FILE.NME$ ' DR062201
IF ZSubParm = -1 OR LOF(7) <2 THEN _ ' DR062201
ZSubParm = SubSave : CLOSE 7 : EXIT SUB ' DR062201
INPUT #7,A$ ' DR062201
CLOSE 7 ' DR062201
CALL QuickTPut ("",1) ' DR062201
CALL QuickTPut (ZFG3$ + A$ + ZEmphasizeOff$,1) ' DR062201
OPEN "O",7,FILE.NME$ ' DR062201
CLOSE 7 ' DR062201
ZSubParm = SubSave ' DR062201
END SUB ' DR062201
* INSERTING new line(s)
5805 ' $SUBTITLE: 'VIEWSTAT - subroutine to update the view stats ' DR062201
' $PAGE ' DR062201
' ' DR062201
' NAME -- VIEWSTAT ' DR062201
' ' DR062201
' PURPOSE -- UPDATES THE USER'S AVAILABILITY STATUS ' DR062201
' ' DR062201
SUB VIEWSTAT (UserPosition$) STATIC ' DR062201
ON ERROR GOTO 65000 ' DR062201
' *****************************************************************************
' * UPDATE USER'S VIEWING STATISTICS FOR VIEWING *
' *****************************************************************************
' ' DR062201
FILE.NME$="RBBS"+MID$("1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ", _ ' DR062201
VAL (ZNodeID$),1) + "VW" ' DR062201
A$ = ZActiveUserName$ ' DR062201
UP$ = LEFT$(UserPosition$,1) ' DR062201
IF UP$ = "A" THEN _ ' DR062201
A$ = A$ + "~ is available for paging on @node " + ZNodeID$ _ ' DR062201
ELSE IF UP$ = "B" THEN _ ' DR062201
A$ = A$ + "~ is entering a message on @node " + ZNodeID$ _ ' DR062201
ELSE IF UP$ = "C" THEN _ ' DR062201
A$ = A$ + "~ is reading messages on @node " + ZNodeID$ _ ' DR062201
ELSE IF UP$ = "D" THEN _ ' DR062201
A$ = A$ + "~ is reading bulletins on @node " + ZNodeID$ _ ' DR062201
ELSE IF UP$ = "E" THEN _ ' DR062201
A$ = A$ + "~ is chatting with SYSOP on @node " + ZNodeID$ _ ' DR062201
ELSE IF UP$ = "F" THEN _ ' DR062201
A$ = A$ + "~ has exited through the "+MID$(UserPosition$,2)+_' DR062201
" door on @node " + ZNodeID$ _ ' DR062201
ELSE IF UP$ = "G" THEN _ ' DR062201
A$ = A$ + "~ is downloading a file on @node " + ZNodeID$ _ ' DR062201
ELSE IF UP$ = "H" THEN _ ' DR062201
A$ = A$ + "~ is uploading a file on @node " + ZNodeID$ _ ' DR062201
ELSE IF UP$ = "I" THEN _ ' DR062201
A$ = "SYSOP~ has exited to DOS on @node " + ZNodeID$ _ ' DR062201
ELSE IF UP$ = "J" THEN _ ' DR062201
A$ = A$ + "~ is scanning the files on @node " + ZNodeID$ ' DR062201
OPEN "O",7,FILE.NME$ ' DR062201
WRITE #7,A$ ' DR062201
CLOSE 7 ' DR062201
END SUB ' DR062201
5900 ' $SUBTITLE: 'VIEWUSER - subroutine to view other users ' DR062201
' $PAGE ' DR062201
' ' DR062201
' NAME -- VIEWUSER ' DR062201
' ' DR062201
' PURPOSE -- VIEWS OTHER USERS' CURRENT POSITIONS ' DR062201
' ' DR062201
SUB VIEWUSER (NodeNum$) STATIC ' DR062201
ON ERROR GOTO 65000 ' DR062201
' ' DR062201
' *****************************************************************************
' * VIEW USERS ON OTHER NODES *
' *****************************************************************************
' ' DR062201
CALL UPDTCALR ("viewed other users",1) ' DR062201
FILE.NME$="RBBS"+MID$("1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ", _ ' DR062201
VAL (NodeNum$),1) + "VW" ' DR062201
ZSubParm = 1 ' DR062201
OPEN "I",7,FILE.NME$ ' DR062201
IF ZSubParm = -1 THEN ViewMessage$ = ZFG1$ + "Node " + _ ' DR062201
NodeNum$ + ZFG2$ + " is awaiting next caller" : GOTO 5901 ' DR062201
INPUT #7,ViewMessage$ ' DR062201
5901 CLOSE 7 ' DR062201
ViewMesgLen = LEN(ViewMessage$) ' DR062201
FOR ViewCount = ViewMesgLen TO 1 STEP -1 ' DR062201
IF MID$(ViewMessage$,ViewCount,1)="~" THEN _ ' DR062201
NewMessage$ = ZFG1$ + LEFT$(ViewMessage$,ViewCount-1) + _ ' DR062201
ZFG2$ + RIGHT$(ViewMessage$,LEN(ViewMessage$)-ViewCount) : _ ' DR062201
ViewMessage$ = NewMessage$ : GOTO 5904 ' DR062201
5902 IF MID$(ViewMessage$,ViewCount,1)="@" THEN _ ' DR062201
NewMessage$ = LEFT$(ViewMessage$,ViewCount - 1) + ZFG3$ + _ ' DR062201
RIGHT$(ViewMessage$,LEN(ViewMessage$) - ViewCount) + _ ' DR062201
ZEmphasizeOff$ : ViewMessage$ = NewMessage$ ' DR062201
5904 NEXT ViewCount ' DR062201
A$ = ViewMessage$ ' DR062201
CALL QuickTPut ("",1) ' DR062201
CALL QuickTPut (A$,1) ' DR062201
PAGE = 0 : FOR CountView = 1 TO 60 ' DR062201
IF MID$(ViewMessage$,CountView,4) = "down" OR _ ' DR062201
MID$(ViewMessage$,CountView,4) = "uplo" OR _ ' DR062201
MID$(ViewMessage$,CountView,4) = "exit" THEN _ ' DR062201
CountView = 60 : PAGE = 1 ' DR062201
NEXT : IF PAGE <> 1 THEN 5910 ' DR062201
5905 EXIT SUB ' DR062201
5910 PAGE = 0 ' DR062201
5915 A$ = ZFG1$ + "Would you like to page " + ZFG3$ + "node" + _ ' DR062201
NodeNum$ + ZFG1$ + " to exit to The Chat DOOR ( " + _ ' DR062201
ZFG4$+ "Y" +ZFG1$+")es, " + ZEmphasizeOn$ + "[N]" + ZFG1$ + _' DR062201
"o )" + ZEmphasizeOff$ ' DR062201
SubParm = 1 ' DR062201
CALL QuickTPut (A$,0) : ZOutTxt$ = "" ' DR062201
CALL TGET ' DR062201
IF ZYES THEN 5920 ' DR062201
GOTO 5905 ' DR062201
5920 FILE.NME$="RBBS"+MID$("1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ", _ ' DR062201
VAL (NodeNum$),1) + "PG" ' DR062201
CALL UPDTCALR ("paged node " + NodeNum$ + " to chat",1) ' DR062201
OPEN "O",7,FILE.NME$ ' DR062201
PRINT #7, ZActiveUserName$ + " from node " + ZNodeID$+ _ ' DR062201
" wants to chat in The Chat DOOR." ' DR062201
CLOSE 7 : GOTO 5905 ' DR062201
END SUB ' DR062201
* REPLACING old line(s) by new
13670 LSET ZCallersRecord$ = WasX$
* ------[ first line different ]------
CalrNode$ = ZCallersRecord$ ' DR062202
WHILE RIGHT$(CalrNode$,1)=" " ' DR062202
CalrNode$ = LEFT$(CalrNode$,LEN(CalrNode$) - 1) ' DR062202
WEND ' DR062202
CalrNode$ = CalrNode$ + " on node " + ZNodeID$ ' DR062202
CALL Printit (CalrNode$) ' DR062202
ZCallersFileIndex! = ZCallersFileIndex! + 1
* REPLACING old line(s) by new
65000 IF ZDebug THEN _
ZOutTxt$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
STR$(ERL) + _
" ERR=" + _
STR$(ERR) : _
IF ZPrinter THEN _
CALL Printit(ZOutTxt$) _
ELSE CALL LPrnt(ZOutTxt$,1)
ZErrCode = ERR
'
' SetCall
'
IF ERL = 108 THEN _
CALL PScrn ("Unable to create callers log " + ZCallersFile$) : _
SYSTEM
IF ERL = 110 THEN _
RESUME NEXT
'
' OPEN CONFIG FILE
'
IF ERL => 117 AND ERL <= 119 THEN _
RESUME NEXT
'
' OPEN COM PORT ERROR HANDLING
'
IF ERL = 200 THEN _
CLS : _
CALL PScrn (ZComPort$ + " does not exist/not responding- Error" + STR$(ERR)) : _
STOP
* ------[ first line different ]------
' ' DR062201
' ViewChek ERROR HANDLING ' DR062201
' ' DR062201
IF ERL = 1204 AND (ERR = 53 OR ERR = 52) THEN _ ' DR062201
ZSubParm = -1 : _ ' DR062201
RESUME NEXT ' DR062201
'
' GetCom ERROR HANDLING
'
IF ERL = 1420 AND ERR = 57 THEN _
RESUME NEXT
IF ERL = 1420 AND ERR = 69 THEN _
ZSubParm = -1 :_
RESUME NEXT
'
' OPENRESEQ ERROR HANDLING
'
IF ERL = 1480 OR ERL = 1487 THEN _
ZErrCode = ERR : _
RESUME NEXT
' ' DR062201
' ViewStat ERROR HANDLING ' DR062201
' ' DR062201
IF ERL = 5805 AND _ ' DR062201
(ERR = 55 OR (ERR = 75 AND ZShareIt)) THEN _ ' DR062201
CALL DelayTime (30) : _ ' DR062201
RESUME ' DR062201
' ' DR062201
' ViewUser ERROR HANDLING ' DR062201
' ' DR062201
IF ERL = 5900 AND ERR = 52 THEN _ ' DR062201
CALL DelayTime (30) : _ ' DR062201
RESUME ' DR062201
IF ERL = 5900 AND ERR = 53 THEN _ ' DR062201
ZSubParm = -1 : _ ' DR062201
RESUME ' DR062201
'
' OpenUser ERROR HANDLING
'
IF ERL = 9400 AND ERR = 75 AND ZShareIt THEN _
CALL DelayTime (30) : _
RESUME
'
' FindUser ERROR HANDLING
'
IF ERL = 12610 OR ERL = 12600 THEN _
RESUME NEXT
'
' UpdtCalr ERROR HANDLING
'
IF ERL = 13663 THEN _
RESUME NEXT
IF ERL = 13672 AND ERR = 61 THEN _
CALL QuickTPut1 ("Disk Full") : _
IF ZDiskFullGoOffline THEN _
GOTO 65010 _
ELSE RESUME NEXT
IF ERL = 13672 THEN _
ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
RESUME NEXT
'
' ZPrinter ERROR HANDLING
'
IF ERL = 13674 THEN _
ZPrinter = ZFalse : _
RESUME
'
' ChangeDir ERROR HANDLING
'
IF ERL = 20103 THEN _
ZOK = ZFalse : _
RESUME NEXT
'
' FindIt ERROR HANDLING
'
IF ERL = 20221 THEN _
RESUME NEXT
IF ERL = 20223 AND ZErrCode = 58 THEN _
ZErrCode = 64 : _
ZOK = ZFalse : _
RESUME NEXT
IF ERL = 20223 AND ZErrCode = 76 THEN _
CALL LPrnt("Bad path. File name is " + FilName$,1) : _
ZErrCode = 76 : _
ZOK = ZFalse : _
RESUME NEXT
IF ERL => 20221 AND ERL <= 20223 AND ZErrCode = 70 _
AND ZNetworkType = 6 THEN _
ZErrCode = 0 : _
RESUME NEXT
IF ERL => 20221 AND ERL <= 20223 THEN _
RESUME
'
' FlushCom ERROR HANDLING
'
IF ERL = 20311 AND ERR = 57 THEN _
RESUME NEXT
IF ERL = 20311 AND ERR = 69 THEN _
ZAbort = ZTrue : _
ZSubParm = -1 : _
RESUME NEXT
'
' NetBIOS ERROR HANDLING
'
IF ERL => 29900 AND ERL <= 29920 THEN _
RESUME NEXT
'
' UpdateC ERROR HANDLING
'
IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
ZOutTxt$ = "* Disk full - terminating *" : _
ZSubParm =2 : _
CALL TPut : _
IF ZDiskFullGoOffline THEN _
GOTO 65010 _
ELSE SYSTEM
'
' CheckInt ERROR HANDLING
'
IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
ZNotCTS = ZTrue : _
CALL Line25 : _
ZErrCode = 0 : _
RESUME
IF ERL => 52000 AND ERL <= 59725 THEN _
RESUME NEXT
'
' FindFile ERROR HANDLING
'
IF ERL = 59791 THEN _
IF ERR <> 57 THEN _
RESUME NEXT _
ELSE IF ERR = 57 THEN _
CALL DelayTime (1) : _
CALL UpdtCalr ("SLOW I/O ERROR",1) : _
IOErrorCount = IOErrorCount + 1 : _
IF IOErrorCount < 11 THEN _
RESUME
'
' CATCH ALL OTHER ERRORS
'
ZOutTxt$ = "RBBS-SUB1 Untrapped Error" + _
STR$(ERR) + _
" in line" + _
STR$(ERL)
CALL QuickTPut1 (ZOutTxt$)
CALL UpdtCalr (ZOutTxt$,2)
RESUME NEXT
' SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL